#!/usr/bin/perl

my $debug = 0;
my $strictlybetter = 1;

# Check parameters
if (! (defined($ARGV[0]) && defined($ARGV[1]) && defined($ARGV[2]))) {
	print "Usage: greedy-genes <language> <corpus-size> <genes>\n";
	exit(1);
}

# Parameters
my $lang = $ARGV[0] || "danish";
my $size = $ARGV[1] || 15;
my $ngenes = $ARGV[2] || 300;
my $rounds = $ngenes;

# Corpus size and desired computation time
my $maxtime = 24 * 3600;
my $timeshrink = 0.85;
my $minsize = 10;
my $maxsize = 500;
my $threads = 6;

# Compute time parameters
my $maxtimePerIteration = $maxtime * (1 - $timeshrink);
my $avgtime = 200; # Average number of seconds a process batch takes per 1000 training words
my $totalTime = 0;
my $totalIGroups = 0;

# Initial skipping
my $skip = {};
my $keeplist = [110, 127, 136, 138, 140, 145, 212, 217, 261, 263, 267,
	269, 278, 282, 284, 285, 287, 289];
for (my $i = 0; $i < $ngenes; ++$i) {
	$skip->{$i} = 1;
}
foreach my $k (@$keeplist) {
	delete $skip->{$k};
}


# Set number of genes, initial bit value, and direction (1=lowest bit
# first, -1 = highest bit first)
my $startbit = 0;
my $initial = 1;
my $direction = 1;
my $time = `date '+%Y%m%d-%H%M%S'`;
chomp($time);
my $name = "greedy-gene-$time";
my $id = 1000;
my $pause = $debug ? 1 : 30;

# Initialize genes
my $genes = [];
for (my $i = 0; $i < $ngenes; ++$i) {
	$genes->[$i] = $initial;
}
$genes = genesFromString($genestring)
	if (defined($genestring));
$predefined = {};
map {$skip->{$_} = 1; $genes->[$_] = 0;} (0,1,2,3,4,5,6,7,8,9,10,11,12,13,111,112,113,114,115,116,117,118,119,120,121,122);

# Optimize
print "\ngreedy-init: lang=$lang, size=$size, ngenes=$ngenes, rounds=$rounds, name=$name, genes=" . geneString($genes) . "\n";
optimize($genes);

# Optimize
sub optimize {
	my $genes = shift;
	my $improvements = [];
	my $score = undef;
	
	# Iterate over genes in sequence
	my $round = 1;
	for (; $round <= $rounds; ++$round) {
		# Compute training size
		my $iterationGenes = $ngenes - keys(%$skip);
		my $iterationThreadGroups = int(($iterationGenes + 1.0) / $threads) + 1;
		my $maxtimePerThread = int(($maxtimePerIteration + 0.0) / $iterationThreadGroups);
		$trainingSize = min($maxsize, max($minsize, int($maxtimePerThread / $avgtime)));
		$size = $trainingSize;

		print "\ngreedy-round: Round $round, " . scalar(@$improvements) . " improvements, newsize=$size, igenes=$iterationGenes, igroups=$iterationThreadGroups, maxtimeI=$maxtimePerIteration, maxtimeT=$maxtimePerThread, avgtime=$avgtime\n\n";
		$improvements = [];

		my $bit = $direction > 0 ? 0 : $ngenes - 1;
		$bit = $startbit
			if ($round == 1);

		$score = undef;
		my $bestscore = -1e20;
		my $bestbit = undef;
		while ($bit >= 0 && $bit < $ngenes) {
			print "Processing from bit $bit with direction $direction\n";
			# Create gene pool for threads, and add current genes as
			# the first if
			my $genepool = [];
			push @$genepool, ["base", geneString($genes)]
				if (! defined($score));
			while (scalar(@$genepool) < $threads && $bit >= 0 && $bit < $ngenes) {
				if (! $skip->{$bit}) {
					flip($genes, $bit);
					push @$genepool, [$bit, geneString($genes)];
					flip($genes, $bit);
				}
				$bit += $direction;
			}
			my $elapsed = 0 - time();
			my $scores = multiscores($genepool, $score);
			$elapsed += time();
			$totalTime += $elapsed;
			$totalIGroups += 1;

			# Retrieve score if missing
			my $i0 = 0;
			if (! defined($score)) {
				$score = $scores->[0];
				$bestscore = $score;
				$i0 = 1;
				print "greedy-base: " . geneString($genes) . " " . $score . " ($elapsed seconds)\n";
			}

			# Find all flips that lead to an improvement over the current score in the round
			for (my $i = $i0; $i < scalar(@$genepool); ++$i) {
				my $newscore = $scores->[$i];
				my $newbit = $genepool->[$i][0];
				my $newgenes = $genepool->[$i][1];
				print "greedy-" . ($newscore < $score ? "drop: " : ($newscore >= $bestscore ? "better: " : "keep: "))
					. $newgenes . " " . $newscore 
					. " (flip " . $newbit . " from $score, $elapsed seconds)\n";
				if ($newscore < $score || ($newscore <= $score && $strictlybetter)) {
					$skip->{$newbit} = 1;
				} else {
					push @$improvements, $genepool->[$i];
					if ($newscore >= $bestscore) {
						$bestscore = $newscore;
						$bestbit = $newbit;
					}
				}
			}
		}
		
		# Execute best improvement
		if (defined($bestbit) && $bestscore > $score) {
			$bit = $bestbit;
			$score = $bestscore;
			flip($genes, $bit);
			$skip->{$bit} = 1;
			print "greedy-best: " . geneString($genes) . " $score (flip $bit)\n";

			# Update corpus size
			my $nimprove = scalar(@$improvements) + 1;
			$maxtimePerIteration = int($timeshrink * $maxtimePerIteration);
			$avgtime = ($debug || $totalIGroups <= 0) ? $avgtime : $totalTime / $totalIGroups / $size;
		} else {
			last;
		}
	}

	print "greedy-final: " . geneString($genes) . " $score (rounds=$rounds maxtime=$maxtimePerIteration avgtime=$avgtime)\n";
}

sub max {
	my $max = shift;
	while (@_) {
		my $value = shift;
		$max = $value if ($value > $max);
	}
	return $max;
}

sub min {
	my $min = shift;
	while (@_) {
		my $value = shift;
		$min = $value if ($value < $min);
	}
	return $min;
}

# Subroutines
sub flip {
	my $genes = shift;
	my $i = shift;
	$genes->[$i] = 1 - $genes->[$i];
}

# Generate bit string
sub geneString {
	my $genes = shift;
	my $bit0 = $ngenes - ($ngenes % 4);
	my $s = "";
	while ($bit0 >= 0) {
		my $digit = 0;
		$digit += 1 if ($genes->[$bit0] > 0);
		$digit += 2 if ($genes->[$bit0 + 1] > 0);
		$digit += 4 if ($genes->[$bit0 + 2] > 0);
		$digit += 8 if ($genes->[$bit0 + 3] > 0);
		$s .= chr($digit + ($digit < 10 ? 48 : 87));
        $bit0 -= 4;
    }
    return $s;
}

sub genesFromString {
	my $string = shift;
	my $genes = [];
	for (my $i = 0; $i < length($string); ++$i) {
		my $digit = ord(substr($string, $i, 1));
		$digit -= ($digit < 97 ? 48 : 87);
		my $bit0 = (length($string) - $i - 1) * 4;
		$genes->[$bit0 + 0] = $digit & 1;
		$genes->[$bit0 + 1] = $digit & 2;
		$genes->[$bit0 + 2] = $digit & 4;
		$genes->[$bit0 + 3] = $digit & 8;
	}
	return $genes;
}

# Calculate scores
sub score {
	my $genestring = shift;

	# Debugging
	my $fullname="$name-$id";
	$id++;
	my $cmd = "sh experiments/experiment2 $fullname $lang $size -train.iterations1=0 -train.iterations2=10 -eval.traincorpus=false -genes=$genestring";
	print $cmd . "\n";
	return 0
		if ($debug);

	# Run experiment
	system($cmd);

	# Find scores
	my $incscore = `grep "Labeled *attachment score" experiments/results/*$fullname.ip.eval | sed -e 's/^.* = //g' -e 's/ %\$//g'`;
	my $mstscore = `grep "Labeled *attachment score" experiments/results/*$fullname.mst.eval | sed -e 's/^.* = //g' -e 's/ %\$//g'`;
	chomp($incscore);
	chomp($mstscore);
	print $incscore $mstscore;
	return $incscore;
}

sub multiscores {
	my $genepool = shift;	
	my $bestscore = shift;

	# Start threads in background
	my $names = [];
	my $scores = [];
	for (my $i = 0; $i < scalar(@$genepool); ++$i) {
		$id++;
		my $fullname = $names->[$i] = "$name-$id";
		my $genestring = $genepool->[$i][1];
		my $cmd = "sh experiments/experiment2 $fullname $lang $size -train.iterations1=0 -train.iterations2=10 -eval.traincorpus=false -genes=$genestring &";
		print $cmd . "\n";
		print "multiscore: bit " . $genepool->[$i][0] . " with $cmd\n";
		if ($debug) {
			$scores->[$i] = rand(1) - 0.7;
		} else {
			$scores->[$i] = undef;
			system($cmd);
		}
	}

	# Collect scores
	my $done = 0;
	while (! $done) {
		$done = 1;
		sleep $pause;
		for (my $i = 0; $i < scalar(@$names); ++$i) {
			if (! defined($scores->[$i])) {
				my $fullname = $names->[$i];
				my $incscore = `grep "Labeled *attachment score" experiments/results/*$fullname.ip.eval 2>/dev/null | sed -e 's/^.* = //g' -e 's/ %\$//g'`;
				my $mstscore = `grep "Labeled *attachment score" experiments/results/*$fullname.mst.eval 2>/dev/null | sed -e 's/^.* = //g' -e 's/ %\$//g'`;
				chomp($incscore);
				chomp($mstscore);
				if (defined($incscore) && $incscore !~ /^\s*$/) {
					$scores->[$i] = $incscore;
				} else {
					$done = 0;
				}
			}
		}
	}

	# Find scores
	return $scores;
}
